home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gwuada_9.zip
/
GNODES.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-07-27
|
21KB
|
837 lines
/*
* Copyright (C) 1985-1992 New York University
*
* This file is part of the Ada/Ed-C system. See the Ada/Ed README file for
* warranty (none) and distribution info and also the GNU General Public
* License for more details.
*/
/* gnodes.c - translation of gnodes.stl */
#define GEN
#include "hdr.h"
#include "vars.h"
#include "gvars.h"
#include "chapp.h"
#include "gmiscp.h"
#include "dbxp.h"
#include "setp.h"
#include "miscp.h"
#include "smiscp.h"
#include "chapp.h"
#include "gutilp.h"
#include "gnodesp.h"
/*
* Tree construction procedures
*--------------------
* 2. Lexical elements
*/
Node new_number_node(int value) /*;new_number_node*/
{
/* constructs an number node, used to hold small integer values used for
* attributes and return statement depth.
*/
Node node;
node = node_new(as_number);
N_VAL (node) = (char *) value;
return node;
}
Node new_instance_node(Tuple value) /*;new_instance_node*/
{
/* constructs an instance node, used to hold tups used for instantiations */
Node node;
node = node_new(as_instance_tuple);
N_VAL (node) = (char *) value;
return node;
}
void make_ivalue_node(Node node, Const value, Symbol typ) /*;make_ivalue_node*/
{
/* constructs an ivalue node */
int nk;
nk = N_KIND(node);
if (N_AST1_DEFINED(nk)) N_AST1(node) = (Node) 0;
if (N_AST2_DEFINED(nk)) N_AST2(node) = (Node) 0;
if (N_AST3_DEFINED(nk)) N_AST3(node) = (Node) 0;
if (N_AST4_DEFINED(nk)) N_AST4(node) = (Node) 0;
if (N_LIST_DEFINED(nk)) N_LIST(node) = (Tuple) 0;
N_KIND(node) = as_ivalue;
N_VAL (node) = (char *) value;
N_TYPE(node) = typ;
}
/*
*--------------------------
* 3.2.1 Object declarations
*/
#ifndef BINDER
void make_single_decl_list(Node root, Node decl_node) /*;make_single_decl_list*/
{
/*
* This procedure transforms a declaration with a list of names into a
* list of declarations, each with one sigle name. It is called in the
* case of declarations with side-effect.
* This procedure is ineffective if the original name list has only one
* element.
* root is the root of the tree to duplicate, while decl_node points to
* the actual (original) declaration. The latter is part of the tree, but
* not necessarily the root due to possible pre-statements.
* The declaration is supposed to be fit for the first element of the
* list, so renaming is necessary for all others.
*/
Node id_list_node, first_id, id;
Tuple id_list, decl_list;
Symbol first_name, first_type, id_name;
Fortup ft1;
Symbolmap rename_map;
id_list_node = N_AST1(decl_node);
id_list = tup_copy(N_LIST(id_list_node));
/* tup_copy needed since id_list used destructively in tup_fromb below*/
if (tup_size(id_list) == 1)
return;
first_id = (Node) tup_fromb(id_list);
N_LIST(id_list_node) = tup_new1((char *) first_id);
first_name = N_UNQ (first_id);
first_type = TYPE_OF(first_name);
decl_list = tup_new1((char *) copy_node(root));
FORTUP(id=(Node), id_list, ft1);
id_name = N_UNQ(id);
/* RENAME_MAP = {[first_name, id_name],
* [first_type, TYPE_OF(id_name)] };
*/
rename_map = symbolmap_new();
symbolmap_put(rename_map, first_name, id_name);
symbolmap_put(rename_map, first_type, TYPE_OF(id_name));
node_map = nodemap_new(); /* initialize */
decl_list = tup_with(decl_list,
(char *) instantiate_tree(root, rename_map));
ENDFORTUP(ft1);
N_KIND(root) = as_declarations;
N_AST1(root) = (Node)0;
N_AST2(root) = (Node)0;
N_AST3(root) = (Node)0;
N_AST4(root) = (Node)0;
N_LIST(root) = decl_list;
N_SIDE(root) = TRUE; /* We are called only in case of side-effect */
}
#endif
void make_const_node(Node node, Symbol const_name, Symbol type_name,
Node init_node) /*;make_const_node*/
{
Node list_node;
list_node = new_node(as_list);
N_KIND(node) = as_const_decl;
N_LIST(list_node) = tup_new1((char *) new_name_node(const_name));
N_LIST(node) = (Tuple) 0;
N_VAL (node) = (char *) 0;
N_AST1(node) = list_node ;
N_AST2(node) = new_name_node(type_name) ;
N_AST3(node) = init_node ;
}
Node new_var_node(Symbol var_name, Symbol type_name, Node init_node)
/*;new_var_node*/
{
Node list_node, node;
list_node = new_node(as_list);
N_LIST(list_node) = tup_new1((char *) new_name_node(var_name));
node = new_node(as_obj_decl);
N_AST1(node) = list_node ;
N_AST2(node) = new_name_node(type_name) ;
N_AST3(node) = init_node ;
return node;
}
/*
*---------------------------
* 3.3.2 Subtype declarations
*/
Node new_subtype_decl_node(Symbol type_name) /*;new_subtype_decl_node*/
{
/*
* Creates a subtype declaration node. Only type name initialized, as
* types are fully processed from the symbol table.
*/
Node node;
node = new_node(as_subtype_decl);
N_AST1(node) = new_name_node(type_name);
N_AST2(node) = OPT_NODE;
N_UNQ(node) = type_name;
return node;
}
/*
*----------------
* 3.8 Access type
*/
Node new_null_node(Symbol r_type) /*;new_null_node*/
{
Node node;
node = new_node(as_null) ;
N_TYPE(node) = r_type ;
return node ;
}
/*
*----------
* 4.1 Names
*/
Node new_name_node(Symbol name) /*;new_name_node*/
{
/* constructs an as_simple_name node. */
Node node;
if (name == (Symbol)0)
compiler_error("Name is omega in new_name_node");
node = new_node(as_simple_name);
N_UNQ (node) = name;
return node;
}
void make_name_node(Node node, Symbol name) /*;make_name_node*/
{
/* Transforms node into an as_simple_name node. */
if (name == (Symbol)0)
compiler_error("Name is omega in make_name_node");
N_KIND(node) = as_simple_name;
N_AST1(node) = (Node)0;
N_AST2(node) = (Node) 0;
N_AST3(node) = (Node)0;
N_AST4(node) = (Node) 0;
N_LIST(node) = (Tuple)0;
N_TYPE(node) = (Symbol) 0;
N_VAL (node) = (char *) 0;
N_UNQ (node) = name;
}
/*
*--------------------------
* 4.1.1 Indexed components
*/
Node new_index_node(Node object_node, Tuple index_list, Symbol comp_type)
/*;new_index_node*/
{
/* Build an as_index node */
Node node, list_node;
list_node = new_node(as_list);
N_LIST(list_node) = index_list;
node = new_node(as_index);
N_AST1(node) = object_node ;
N_AST2(node) = list_node ;
N_TYPE(node) = comp_type;
return node;
}
void make_index_node(Node node, Node object_node, Tuple index_list,
Symbol comp_type) /*;make_index_node */
{
/* Build an as_index node */
Node list_node;
list_node = new_node(as_list);
N_LIST(list_node) = index_list;
N_LIST(node) = (Tuple) 0;
N_KIND(node) = as_index;
N_AST1(node) = object_node ;
N_AST2(node) = list_node ;
N_TYPE(node) = comp_type;
}
/*
*--------------------------
* 4.1.3 Selected components
*/
Node new_selector_node(Node object_node, Symbol selector) /*;new_selector_node*/
{
/*
* The selector is a declared component name, or the internal marker
* 'constrained' used to represent the corresponding attribute. This
* name is used for all records with discriminants. Its type is BOOLEAN.
*/
Node node, sel_node;
node = new_node(as_selector) ;
sel_node = new_name_node(selector) ;
N_AST1(node) = object_node ;
N_AST2(node) = sel_node ;
N_TYPE(node) = TYPE_OF(selector) ;
return node ;
}
void make_selector_node(Node node, Node object_node, Symbol selector)
/*;make_selector_node*/
{
/*
* The selector is a declared component name, or the internal marker
* 'constrained' used to represent the corresponding attribute. This
* name is used for all records with discriminants. Its type is BOOLEAN.
*/
Node sel_node;
sel_node = new_name_node(selector) ;
N_KIND(node) = as_selector;
N_LIST(node) = (Tuple) 0;
N_AST1(node) = object_node ;
N_AST2(node) = sel_node ;
N_TYPE(node) = TYPE_OF(selector) ;
}
Node new_discr_ref_node(Symbol d_name, Symbol type_name) /*;new_discr_ref*/
{
Node node;
node = new_node(as_discr_ref) ;
N_AST1(node) = new_name_node(type_name);
N_UNQ(node) = d_name;
N_TYPE(node) = TYPE_OF(d_name);
retu